home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ANSI.SWG / 0005_ANSI Output.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  139 lines
  1. {
  2. > Now that I need to make a .ANS bulletin Type File, I was wondering
  3. > how to Write from a Pascal Program, ANSI control Characters to a
  4. > File and produce nice color bulletin screen to be displayed by RA.
  5.  
  6. The following Unit will enable you to Write Ansi sequences to a Text
  7. File Without having to look them up yourself. It enables you to do this
  8. using the (easier) Crt Unit style of commands, and provides the optimum
  9. Ansi sequence to do the job.
  10. }
  11.  
  12. Unit AnsiOut;
  13. {1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}
  14. {2. Modified to provide output to a Text File.}
  15.  
  16. Interface
  17.  
  18. Const Black = 0;     Blue = 1;          Green = 2;       Cyan = 3;
  19.       Red =   4;     Magenta = 5;       Brown = 6;       LightGray = 7;
  20.       DarkGray = 8;  LightBlue = 9;     LightGreen = 10; LightCyan = 11;
  21.       LightRed = 12; LightMagenta = 13; Yellow = 14;     White = 15;
  22.       Blink = 128;
  23.  
  24. Var AnsiFile: Text;
  25.  
  26. Procedure TextColor(fore : Byte);
  27. Procedure TextBackGround(back : Byte);
  28. Procedure NormVideo;
  29. Procedure LowVideo;
  30. Procedure HighVideo;
  31. Procedure ClrEol;
  32. Procedure ClrScr;
  33.  
  34. Implementation
  35.  
  36. Const forestr: Array[Black..LightGray] of String[2]
  37.                = ('30','34','32','36','31','35','33','37');
  38.       backstr: Array[Black..LightGray] of String[2]
  39.                = ('40','44','42','46','41','45','43','47');
  40.       decisiontree: Array[Boolean, Boolean, Boolean, Boolean] of Integer =
  41.       ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));
  42.  
  43. Var forecolour, backcolour: Byte; { stores last colours set }
  44.     boldstate, blinkstate: Boolean;
  45.  
  46. Procedure TextColor(fore : Byte);
  47.   Var
  48.     blinknow, boldnow: Boolean;
  49.     outstr: String;
  50.   begin
  51.     blinknow := (fore and $80) = $80;
  52.     boldnow := (fore and $08) = $08;
  53.     fore := fore and $07;  { mask out intensity and blink attributes }
  54.     forecolour := fore;
  55.     Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OF
  56.     0: outstr := Concat(#27,'[',forestr[fore],'m');
  57.     1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');
  58.     2: outstr := Concat(#27,'[1;',forestr[fore],'m');
  59.     3: outstr :=
  60.          Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');
  61.     4: outstr := Concat(#27,'[5;',forestr[fore],'m');
  62.     5: outstr :=
  63.          Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');
  64.     6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');
  65.     end; { Case }
  66.     Write(AnsiFile,outstr);
  67.     blinkstate := blinknow;
  68.     boldstate := boldnow;
  69.   end;
  70.  
  71. Procedure TextBackGround(back: Byte);
  72.   Var outString: String;
  73.   begin
  74.     if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }
  75.     BackColour := Back;
  76.     outString := Concat(#27,'[',backstr[back],'m');
  77.     Write(AnsiFile,outString)
  78.   end;
  79.  
  80. Procedure NormVideo;
  81.   begin
  82.     Write(AnsiFile,#27'[0m');
  83.     forecolour := LightGray;
  84.     backcolour := Black;
  85.     boldstate := False;
  86.     blinkstate := False
  87.   end;
  88.  
  89. Procedure LowVideo;
  90.   begin
  91.     if blinkstate then forecolour := forecolour or $80;  { retain blinking }
  92.     TextColor(forecolour);   { stored forecolour never contains bold attr }
  93.   end;
  94.  
  95. Procedure HighVideo;
  96.   begin
  97.     if not boldstate then
  98.     begin
  99.       boldstate := True;
  100.       Write(AnsiFile,#27,'[1m')
  101.     end;
  102.   end;
  103.  
  104. Procedure ClrEol;
  105.   begin
  106.     Write(AnsiFile,#27'[K')
  107.   end;
  108.  
  109. Procedure ClrScr;
  110.   begin
  111.     Write(AnsiFile,#27'[2J');
  112.   end;
  113.  
  114. begin
  115.   forecolour := LightGray;
  116.   backcolour := Black;
  117.   boldstate := False;
  118.   blinkstate := False
  119. end.
  120.  
  121. ___------------------------------------------------------------------
  122. Program Demo;
  123. Uses AnsiOut;
  124. begin
  125.   Assign(AnsiFile,'CON');   { or a File - e.g. 'MYSCREEN.ANS' }
  126.   ReWrite(AnsiFile);
  127.   ClrScr;
  128.   TextColor(Blue); TextBackGround(LightGray);
  129.   Writeln(AnsiFile,' Blue Text on LightGray ');
  130.   HighVideo; Write(AnsiFile,' Now the Text is LightBlue ');
  131.   TextBackground(Red); Writeln(AnsiFile,' on a Red background');
  132.   TextColor(Black+Blink); TextBackground(Cyan);
  133.   Writeln(AnsiFile,' Blinking Black ');
  134.   TextBackGround(Green); ClrEol;         { a blank Green line }
  135. (53 min left), (H)elp, More?   Writeln(AnsiFile);
  136.   NormVideo;
  137.   Close(AnsiFile);
  138. end.
  139.